Goal of the script

This script plots all sensor data in order to visualizes the measurements recorded throughout the tool function experiment. In this study the variable of interest is the Penetration depth

dir_in <- "../derived_data"
dir_out <- "../plots"

Raw data must be located in ~/../derived_data.
Formatted data will be saved in ~/../plots. The knit directory for this script is the project directory.


Load packages

library(R.utils)
library(ggplot2)
library(tools)
library(tidyverse)
library(patchwork)
library(doBy)
library(ggrepel)
library(openxlsx)

Get name, path and information of the file

data_file <- list.files(dir_in, pattern = "\\.Rbin$", full.names = TRUE)
md5_in <- md5sum(data_file)
info_in <- data.frame(file = basename(names(md5_in)), checksum = md5_in, row.names = NULL)
info_in

Load data into R object

imp_data <- loadObject(data_file)
str(imp_data)
'data.frame':   114706 obs. of  10 variables:
 $ Sample          : chr  "DAC3-2" "DAC3-2" "DAC3-2" "DAC3-2" ...
 $ Raw_material    : chr  "Dacite" "Dacite" "Dacite" "Dacite" ...
 $ Contact_material: chr  "wood" "wood" "wood" "wood" ...
 $ Stroke          : num  1 1 1 1 1 1 1 1 1 1 ...
 $ Step            : num  1 2 3 4 5 6 7 8 9 10 ...
 $ Force           : num  -58.8 -59.3 -61.6 -56.7 -58 ...
 $ Friction        : num  -2.46 -9.88 -31.78 -53.99 -64.34 ...
 $ Depth           : num  13.8 13.8 13.6 13.3 13.1 ...
 $ Position        : num  260 263 297 356 387 ...
 $ Velocity        : num  -0.0031 106.7299 502.972 551.2161 162.7834 ...
# replace "stroke" by "cycle"
colnames(imp_data)[colnames(imp_data) == "Stroke"] <- "Cycle"

The imported file is: “~/../derived_data/sampl.Rbin”

Plot each of the selected numeric variable

Plot showing the absolut penetration depths

# calculates the absolute depths reached per sample
abs.depth <- function(x) {
  noNA <- x[!is.na(x)]
  out <- abs(min(noNA) - max(noNA))
}

# Define grouping variable and compute the summary statistics 
depth <- summaryBy(Depth ~ Sample+Raw_material+Contact_material, 
                  data=imp_data, 
                  FUN=abs.depth)

str(depth)
'data.frame':   12 obs. of  4 variables:
 $ Sample          : chr  "DAC3-2" "DAC3-4" "DAC3-6" "FLT10-2" ...
 $ Raw_material    : chr  "Dacite" "Dacite" "Dacite" "Flint" ...
 $ Contact_material: chr  "wood" "wood" "wood" "wood" ...
 $ Depth.abs.depth : num  2.94 2.5 2.91 2.88 3.89 ...
depth[["Contact_material"]] <- factor(depth[["Contact_material"]])

# plots all depth points in one facet plot (contact material together)
p3 <- ggplot(data = depth, aes(x = Contact_material, 
                               y = Depth.abs.depth, colour = 
                                 Raw_material)) +
       geom_point() + labs(y = "Absolute depth (mm)") +
       facet_wrap(~Raw_material, strip.position = "bottom") +
       # avoids overplotting of the labels (sample IDs)
       geom_text_repel(aes(label=Sample), size = 2, 
                       nudge_x = -0.4, 
                       segment.size = 0.1, force = 2, 
                       seed = 123) +
       scale_y_continuous(trans = "reverse") +
       scale_x_discrete(position ="top") +
       # removes the "_" between "Contact_material in the legend 
       labs(x = "Contact material") + 
         theme_classic() +
       theme(legend.position = "none") 
      
print(p3)

# save to PDF
file_out <- paste0(file_path_sans_ext(info_in[["file"]]), 
                   "_depth_a_plot_", ".pdf")
ggsave(filename = file_out, plot = p3, path = dir_out, 
       device = "pdf", 
       width = 25, height = 17, units = "cm")


depth[["Raw_material"]] <- factor(depth[["Raw_material"]])

# plots all depth points in one facet plot (contact material separated)
p4 <- ggplot(data = depth, aes(x = Contact_material, 
                               y = Depth.abs.depth, colour = 
                                 Raw_material)) +
       geom_point() + labs(y = "Absolute depth (mm)") +
       # avoids overplotting of the labels (sample IDs)
       geom_text_repel(aes(label=Sample), size = 2, 
                       nudge_x = -0.4, 
                       segment.size = 0.1, force = 2, 
                       seed = 123) +
       scale_y_continuous(trans = "reverse") +
       scale_x_discrete(position ="top") +
       # removes the "_" between "Contact_material in the legend 
       labs(x = "Contact material") + 
         theme_classic() +
       theme(axis.text.x = element_blank(), axis.ticks = element_blank()) +
       theme(legend.position = "none") 
      
print(p4)

# save to PDF
file_out <- paste0(file_path_sans_ext(info_in[["file"]]), 
                   "_depth_b_plot_", ".pdf")
ggsave(filename = file_out, plot = p4, path = dir_out, 
       device = "pdf", 
       width = 25, height = 17, units = "cm")

All sensor data

sp <- split(imp_data, imp_data[["Sample"]])

for (i in seq_along(sp)) {
  # creates a sequence of every ~ 50th strokes 
  seq_st <- seq(1, length(unique(sp[[i]][["Cycle"]])), by = 40) %>% 
            c(max(unique(sp[[i]][["Cycle"]])))
  dat_i_all <- sp[[i]] %>% 
               filter(Cycle %in% seq_st)
  range_force_all <- range(dat_i_all[["Force"]])
  range_friction_all <- range(dat_i_all[["Friction"]])
  range_depth_all <- range(dat_i_all[["Depth"]])
  range_velocity_all <- range(dat_i_all[["Velocity"]])
       
  
    p1b <- ggplot(data = dat_i_all) +
        geom_line(aes(x = Step, y = Force, colour = Cycle, group = Cycle), alpha = 0.3) + 
        labs(x = "Step", y = "Force [N]") + 
        scale_colour_continuous(trans = "reverse") + 
        coord_cartesian(ylim = range_force_all) +
        scale_x_continuous(breaks=c(1, 4, 7, 10, 15, 20, 25)) +
          theme_classic()
  print(p1b)
  
    p2b <- ggplot(data = dat_i_all) +
        geom_line(aes(x = Step, y = Friction, colour = Cycle, group = Cycle), alpha = 0.3) + 
        labs(x = "Step", y = "Friction [N]") + 
        scale_colour_continuous(trans = "reverse") + 
        coord_cartesian(ylim = range_friction_all) +
        scale_x_continuous(breaks=c(1, 4, 7, 10, 15, 20, 25)) +
          theme_classic()
  print(p2b)
  
  p3b <- ggplot(data = dat_i_all) +
        geom_line(aes(x = Step, y = Depth, colour = Cycle, group = Cycle), alpha = 0.3) + 
        labs(x = "Step", y = "Depth [mm]") + 
        scale_colour_continuous(trans = "reverse") + 
        coord_cartesian(ylim = range_depth_all) +
        scale_x_continuous(breaks=c(1, 4, 7, 10, 15, 20, 25)) +
          theme_classic()
  print(p3b)
  
    p4b <- ggplot(data = dat_i_all) +
        geom_line(aes(x = Step, y = Velocity, colour = Cycle, group = Cycle), alpha = 0.3) + 
        labs(x = "Step", y = "Velocity [mm/s]") + 
        scale_colour_continuous(trans = "reverse") + 
        coord_cartesian(ylim = range_velocity_all) +
        scale_x_continuous(breaks=c(1, 4, 7, 10, 15, 20, 25)) +
          theme_classic()
  print(p4b)
  
  # patchwork plot
  pb <- p1b + p2b + p3b + p4b + plot_annotation(title = names(sp)[i]) + plot_layout(ncol = 1, guides = "collect")
  print(pb)
  # save to PDF
  file_out <- paste0(file_path_sans_ext(info_in[["file"]]), "_sensors_plot_", 
                       names(sp)[i], ".pdf")
  ggsave(filename = file_out, plot = pb, path = dir_out, device = "pdf")
} 

Penetration depth plots showing the strokes as lines

# plots all strokes per sample divided by 40 
# splits the data in the individual 24 samples
sp <- split(imp_data, imp_data[["Sample"]])


for (i in seq_along(sp)) {
  # creates a sequence of every ~ 50th cycles 
  seq_st <- seq(1, length(unique(sp[[i]][["Cycle"]])), by = 40) %>% 
            c(max(unique(sp[[i]][["Cycle"]])))
  dat_i_all <- sp[[i]] %>% 
               filter(Cycle %in% 1:500)
  range_depth <- range(dat_i_all[["Depth"]])
  p1 <- ggplot(data = dat_i_all, aes(x = Step, y = Depth, colour = Cycle)) +
        geom_line(aes(group = Cycle), alpha = 0.3) + 
        labs(x = "Step", y = "Depth (mm)") + ylab(NULL) +
        # reverses the legend starting with 0 going to 2000 strokes 
        scale_colour_continuous(trans = "reverse") + 
        coord_cartesian(ylim = range_depth) +
        # changes the 'Step-number' in the x-legend  
        theme_classic()
       
# plots only the first 125 cycles per sample  
  dat_i_250 <- sp[[i]] %>% 
              # takes only the first 50 cycles per sample
              filter(Cycle %in% 1:125)
  range_depth <- range(dat_i_all[["Depth"]])
  p2 <- ggplot(data = dat_i_250) +
        geom_line(aes(x = Step, y = Depth, colour = Cycle, group = Cycle), alpha = 0.3) + 
        labs(x = "Step", y = "Depth (mm)") + 
        scale_colour_continuous(trans = "reverse") + 
        coord_cartesian(ylim = range_depth) +
          theme_classic()

# plots only between 125 to 205 cycles per sample  
  dat_i_500 <- sp[[i]] %>% 
              # takes only the first 50 cycles per sample
              filter(Cycle %in% 126:250)
  range_depth <- range(dat_i_all[["Depth"]])
  p3 <- ggplot(data = dat_i_500) +
        geom_line(aes(x = Step, y = Depth, colour = Cycle, group = Cycle), alpha = 0.3) + 
        labs(x = "Step", y = "Depth (mm)") + 
        scale_colour_continuous(trans = "reverse") + 
        coord_cartesian(ylim = range_depth) +
          theme_classic()
  
  # plots only between 250 to 500 cycles per sample  
  dat_i_500 <- sp[[i]] %>% 
              # takes only the first 50 cycles per sample
              filter(Cycle %in% 251:500)
  range_depth <- range(dat_i_all[["Depth"]])
  p4 <- ggplot(data = dat_i_500) +
        geom_line(aes(x = Step, y = Depth, colour = Cycle, group = Cycle), alpha = 0.3) + 
        labs(x = "Step", y = "Depth (mm)") + 
        scale_colour_continuous(trans = "reverse") + 
        coord_cartesian(ylim = range_depth) +
          theme_classic()  
  
  # patchwork plot
  p <- p2 + p3 + p4 + p1 +plot_annotation(title = names(sp)[i]) 
  print(p)

  # save to PDF
  file_out <- paste0(file_path_sans_ext(info_in[["file"]]), "_depth_plot_", 
                names(sp)[i], ".pdf")
  ggsave(filename = file_out, plot = p, path = dir_out, 
         device = "pdf")
}

The files will be saved as “~/../plots.[ext]”.

# Save data ## Write to XLSX (summary statistics)
r write.xlsx(list(depth = depth, depth_good = depth_good), file = paste0(dir_out, file_out, ".xlsx"))
Error in buildWorkbook(x, asTable = asTable, ...): object 'depth_good' not found

sessionInfo() and RStudio version

sessionInfo()
R version 4.1.0 (2021-05-18)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19043)

Matrix products: default

locale:
[1] LC_COLLATE=English_United States.1252 
[2] LC_CTYPE=English_United States.1252   
[3] LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C                          
[5] LC_TIME=English_United States.1252    

attached base packages:
[1] tools     stats     graphics  grDevices utils     datasets  methods  
[8] base     

other attached packages:
 [1] openxlsx_4.2.4    ggrepel_0.9.1     doBy_4.6.11       patchwork_1.1.1  
 [5] forcats_0.5.1     stringr_1.4.0     dplyr_1.0.7       purrr_0.3.4      
 [9] readr_1.4.0       tidyr_1.1.3       tibble_3.1.2      tidyverse_1.3.1  
[13] ggplot2_3.3.5     R.utils_2.10.1    R.oo_1.24.0       R.methodsS3_1.8.1

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.7           lubridate_1.7.10     curry_0.1.1         
 [4] lattice_0.20-44      assertthat_0.2.1     digest_0.6.27       
 [7] utf8_1.2.1           R6_2.5.0             cellranger_1.1.0    
[10] backports_1.2.1      reprex_2.0.0         evaluate_0.14       
[13] highr_0.9            httr_1.4.2           pillar_1.6.1        
[16] rlang_0.4.11         readxl_1.3.1         rstudioapi_0.13     
[19] Matrix_1.3-3         rmarkdown_2.9        labeling_0.4.2      
[22] munsell_0.5.0        broom_0.7.8          compiler_4.1.0      
[25] Deriv_4.1.3          modelr_0.1.8         xfun_0.24           
[28] microbenchmark_1.4-7 pkgconfig_2.0.3      htmltools_0.5.1.1   
[31] tidyselect_1.1.1     fansi_0.5.0          crayon_1.4.1        
[34] dbplyr_2.1.1         withr_2.4.2          MASS_7.3-54         
[37] grid_4.1.0           jsonlite_1.7.2       gtable_0.3.0        
[40] lifecycle_1.0.0      DBI_1.1.1            magrittr_2.0.1      
[43] scales_1.1.1         zip_2.2.0            cli_3.0.1           
[46] stringi_1.6.2        farver_2.1.0         fs_1.5.0            
[49] xml2_1.3.2           ellipsis_0.3.2       generics_0.1.0      
[52] vctrs_0.3.8          glue_1.4.2           hms_1.1.0           
[55] yaml_2.2.1           colorspace_2.0-2     rvest_1.0.0         
[58] knitr_1.33           haven_2.4.1         

END OF SCRIPT